perm filename COORDS.F4[PUR,LCS] blob sn#396830 filedate 1979-07-23 generic text, type T, neo UTF8
00100		COMMON J(512),K(3),JJ(21),M
00110		TYPE 1000
00120	1000	FORMAT(' FILE NAME (NO EXT.) -- '$)
00130	1001	FORMAT(A5)
00140		ACCEPT 1001,NAME
00200		TYPE 1
00300	1	FORMAT(' TO DSK? TYPE Y OR N'/)
00400		ACCEPT 11,L
00500		M=5
00600		IF(L.NE.'Y')GO TO 3
00700		M=1
00800		TYPE 2
00900	2	FORMAT(' WRITING FILE FOR01.DAT'/)
01000	3	CALL GETFILE(NAME)
01100		CALL FASTIN(JJ,21 )
01200	11	FORMAT(A1)
01300	10	FORMAT(10I8,/I4,/2X,10(3XA5))
01400		WRITE(M,10),JJ
01500		N=JJ(11)
01600	C WD CNT
01700		CALL FASTIN(J,N)
01800		CALL RDRAW(1,J(1),J)
01900		END
02000	
02100		SUBROUTINE RDRAW(I,JA,IJ)
02200		COMMON J(512),K(3),JJ(21),M
02300		DIMENSION IJ(1)
02400		I=1
02500	  	WRITE(M,4),JJ(1)
02600		DO 3 KK=1,10
02700		KA=0
02800		JA=JJ(KK)
02900		DO 2 L=I,JA
03000		CALL UNPACK(L,IA,IB,J)
03100		KA=KA+1
03200	  	IF(L.NE.JA)GO TO 2
03300		KA=0
03400		WRITE(M,4),JJ(KK+11)
03500	2	WRITE(M,10),KA,IA,IB,J(L)
03600	3	I=JA+1
03700	4	FORMAT(/1XA5)
03800	10	FORMAT(4I)
03900		END
04000		SUBROUTINE UNPACK(K,M,N,I)
04100		COMMON/LL/L
04200	C  L IS FOR VIS. OR INVIS. LINES.
04300		DIMENSION I(1)
04400		N=I(K)
04500		L=0
04600		IF(N.LT.100000000)GO TO 2
04700		L=(N/100000000)*100000000
04800		N=N-L
04900	2	M=N/10000
05000		N=N-M*10000
05100		IF(M.GT.1000)M=1000-M
05200		IF(N.GT.1000)N=1000-N
05300		END